home *** CD-ROM | disk | FTP | other *** search
/ Power CD / Power CD ATARI-Rechner Lieben.iso / ACC_CPX / UHRZEIT / DATETIME / DATETIME.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-10-09  |  11.6 KB  |  156 lines
  1. (*****************************************************************************)
  2. (**)                                                                       (**)
  3. (**)            program datum_zeit;           (* Version 1.1 *)            (**)
  4. (**)                                                                       (**)
  5. (*****************************************************************************)
  6.  
  7. (*****************************************************************************)
  8. (* Entwickelt mit ST PASCAL PLUS von CCD.                                    *)
  9. (* Natürlich frei kopierbar.                                                 *)
  10. (* Datum : 8. Februar 1987                                                   *)
  11. (* Autor : Dietmar Rabich, Eschenweg 3, 4408 Dülmen                          *)
  12. (*****************************************************************************)
  13.  
  14. (*****************************************************************************)
  15. (******************************* DEKLARATIONEN *******************************)
  16. (**)                                                                       (**)
  17. (**) var std,min,sek,tag,mon,jahr : integer;                               (**)
  18. (**)                                                                       (**)
  19. (*****************************************************************************)
  20. (*****************************************************************************)
  21.  
  22. (*****************************************************************************)
  23. (******************************* SYSTEMAUFRUFE *******************************)
  24. (**)                                                                       (**)
  25. (**) function getdate:integer;            GEMDOS($2A);                     (**)
  26. (**)                                                                       (**)
  27. (**) procedure setdate(d:integer);        GEMDOS($2B);                     (**)
  28. (**)                                                                       (**)
  29. (**) function gettime:integer;            GEMDOS($2C);                     (**)
  30. (**)                                                                       (**)
  31. (**) procedure settime(z:integer);        GEMDOS($2D);                     (**)
  32. (**)                                                                       (**)
  33. (**) function conin(dev:integer):integer; BIOS(2);                         (**)
  34. (**)                                                                       (**)
  35. (*****************************************************************************)
  36. (*****************************************************************************)
  37.  
  38. (*****************************************************************************)
  39. (*************************** BILDSCHIRMEINSTELLUNG ***************************)
  40. (**)                                                                       (**)
  41. (**) procedure bildschirm_einstellung;                                     (**)
  42. (**)                                                                       (**)
  43. (**)  procedure clear_home;                                                (**)
  44. (**)                                                                       (**)
  45. (**)   begin                                                               (**)
  46. (**)    write (chr (27), 'E');                                             (**)
  47. (**)   end;                                                                (**)
  48. (**)                                                                       (**)
  49. (**)  procedure select_color (color: integer);                             (**)
  50. (**)                                                                       (**)
  51. (**)   begin                                                               (**)
  52. (**)    write (chr (27), 'b', chr (ord ('0') + color & $F));               (**)
  53. (**)   end;                                                                (**)
  54. (**)                                                                       (**)
  55. (**)  procedure select_background (color: integer);                        (**)
  56. (**)                                                                       (**)
  57. (**)   begin                                                               (**)
  58. (**)    write (chr (27), 'c', chr (ord ('0') + color & $F));               (**)
  59. (**)   end;                                                                (**)
  60. (**)                                                                       (**)
  61. (**)  procedure wrap_on;                                                   (**)
  62. (**)                                                                       (**)
  63. (**)   begin                                                               (**)
  64. (**)    write (chr (27), 'v');                                             (**)
  65. (**)   end;                                                                (**)
  66. (**)                                                                       (**)
  67. (**) begin                                                                 (**)
  68. (**)  select_color(0);                                                     (**)
  69. (**)  select_background(1);                                                (**)
  70. (**)  wrap_on;                                                             (**)
  71. (**)  clear_home;                                                          (**)
  72. (**) end;                                                                  (**)
  73. (**)                                                                       (**)
  74. (*****************************************************************************)
  75. (*****************************************************************************)
  76.  
  77. (*****************************************************************************)
  78. (*************************** ZEIT UND DATUM HOLEN ****************************)
  79. (**)                                                                       (**)
  80. (**) procedure hole_zeit_und_datum (var h,m,s,t,mo,j : integer);           (**)
  81. (**)                                                                       (**)
  82. (**)  var zeit,datum : integer;                                            (**)
  83. (**)                                                                       (**)
  84. (**) begin                                                                 (**)
  85. (**)  zeit:=gettime;                                                       (**)
  86. (**)  s:=zeit-shl(shr(zeit,5),5);                                          (**)
  87. (**)  zeit:=shr((zeit-s),5);                                               (**)
  88. (**)  m:=zeit-shl(shr(zeit,6),6);                                          (**)
  89. (**)  h:=shr(zeit,6);                                                      (**)
  90. (**)  s:=s*2;                                                              (**)
  91. (**)  datum:=getdate;                                                      (**)
  92. (**)  t:=datum-shl(shr(datum,5),5);                                        (**)
  93. (**)  datum:=shr((datum-t),5);                                             (**)
  94. (**)  mo:=datum-shl(shr(datum,4),4);                                       (**)
  95. (**)  j:=shr(datum,4);                                                     (**)
  96. (**) end;                                                                  (**)
  97. (**)                                                                       (**)
  98. (*****************************************************************************)
  99. (*****************************************************************************)
  100.  
  101. (*****************************************************************************)
  102. (*************************** ZEIT UND DATUM SETZEN ***************************)
  103. (**)                                                                       (**)
  104. (**) procedure setze_zeit_und_datum (h,m,t,mo,j : integer);                (**)
  105. (**)                                                                       (**)
  106. (**)  var zeit,datum : integer;                                            (**)
  107. (**)                                                                       (**)
  108. (**) begin                                                                 (**)
  109. (**)  zeit:=shl(h,11)+shl(m,5);                                            (**)
  110. (**)  settime(zeit);                                                       (**)
  111. (**)  datum:=shl(j-1980,9)+shl(mo,5)+t;                                    (**)
  112. (**)  setdate(datum);                                                      (**)
  113. (**) end;                                                                  (**)
  114. (**)                                                                       (**)
  115. (*****************************************************************************)
  116. (*****************************************************************************)
  117.  
  118. (*****************************************************************************)
  119. (******************************* HAUPTPROGRAMM *******************************)
  120. (**)                                                                       (**)
  121. (**) begin                                                                 (**)
  122. (**)  bildschirm_einstellung;                                              (**)
  123. (**)  hole_zeit_und_datum(std,min,sek,tag,mon,jahr);                       (**)
  124. (**)  writeln ('***    Zeit und Datum  /  Version 1.1    ***');            (**)
  125. (**)  writeln ('(Bildschirm  ist   auf  weiße   Schrift  mit');            (**)
  126. (**)  writeln ('schwarzem     Grund     eingestellt.     Der');            (**)
  127. (**)  writeln ('Zeilenüberlauf ist aktiviert.)');                          (**)
  128. (**)  writeln ('Entwickelt mit ST PASCAL PLUS von D. Rabich.');            (**)
  129. (**)  writeln ('Zeit : ',std:2,':',min:2,':',sek:2);                       (**)
  130. (**)  writeln ('Datum: ',tag:2,'.',mon:2,'.',1980+jahr:4);                 (**)
  131. (**)  (* Hier ist das Datum der aktuellen TOS-Version eingefügt. *)        (**)
  132. (**)  if (tag=6) and (mon=2) and (jahr=6) then                             (**)
  133. (**)    begin                                                              (**)
  134. (**)     repeat                                                            (**)
  135. (**)      writeln ('Stellen Sie bitte Zeit und Datum ein!');               (**)
  136. (**)      write ('Stunde [hh]:'); readln(std);                             (**)
  137. (**)      write ('Minute [mm]:'); readln(min);                             (**)
  138. (**)      write ('Tag    [tt]:'); readln(tag);                             (**)
  139. (**)      write ('Monat  [mm]:'); readln(mon);                             (**)
  140. (**)      write ('Jahr [jjjj]:'); readln(jahr);                            (**)
  141. (**)      setze_zeit_und_datum(std,min,tag,mon,jahr);                      (**)
  142. (**)      hole_zeit_und_datum(std,min,sek,tag,mon,jahr);                   (**)
  143. (**)      writeln ('Neue Einstellung:');                                   (**)
  144. (**)      writeln ('Zeit : ',std:2,':',min:2,':',sek:2);                   (**)
  145. (**)      writeln ('Datum: ',tag:2,'.',mon:2,'.',1980+jahr:4);             (**)
  146. (**)      writeln ('Bei falscher Eingabe bitte <RETURN> drücken.');        (**)
  147. (**)     until conin(2)<>13;                                               (**)
  148. (**)    end                                                                (**)
  149. (**)   else                                                                (**)
  150. (**)    writeln ('Zeit und Datum werden als korrekt angenommen.');         (**)
  151. (**) end.                                                                  (**)
  152. (**)                                                                       (**)
  153. (*****************************************************************************)
  154. (*****************************************************************************)
  155.  
  156.